home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / 0A.C next >
C/C++ Source or Header  |  1993-07-27  |  35KB  |  1,089 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /* sem0 - part a - initializations */
  10.  
  11. /* TODO
  12.  
  13. 01-nov-84    ds
  14. delete refs to ast_nodes.
  15. Note that need to review initializatio of symbol_short_integer.
  16.  
  17. 19-oct-84    ds
  18. Review copy_node etc to see if proper fields being copied.
  19. Need to review use of copy_node, copy_attributes.
  20.  
  21. sort out SEQUENCE_LIST problem, if initial length ever requires reaalloc
  22. call then malloc is 'botched'. For now have large length in place (about
  23. 600 elements)  ds 15 jul 84
  24.  
  25.  
  26. There is dcl_put in setl to standard, in c to standard0.Things working
  27.  ok now, but sort this out        ds 19 jul
  28.  */
  29.  
  30. #include "hdr.h"
  31. #include "vars.h"
  32. #include "dbxp.h"
  33. #include "dclmapp.h"
  34. #include "arithp.h"
  35. #include "miscp.h"
  36. #include "smiscp.h"
  37. #include "setp.h"
  38. #include "chapp.h"
  39. /* ctype.h needed for isupper, tolower, etc in 4.2 bsd*/
  40.  
  41. extern int ADA_MIN_INTEGER, ADA_MAX_INTEGER;
  42.  
  43. static Declaredmap declared_standard0, declared_standard, declared_ascii,
  44.   declared_unmentionable;
  45. static int init_node_count = 1;   /* node 0 is OPT_NODE jc 2/8/86 */
  46. /* NOTE: if change op_desig_array, also change desig_of_op (chap 12)*/
  47. static char *op_desig_array[] = {
  48.     "and", "or", "xor", "not", "mod", "rem", "abs",
  49.     "=", "/=", "<=", "<", ">=", ">",
  50.     "+", "-", "&", "*", "/", "**", 0
  51. };
  52.  
  53. static Node val_node1(int);
  54. static Node val_nodea1(int);
  55. static Node val_node2(double);
  56. static Node val_node3(Rational);
  57. static void init_node_save(Node);
  58. static Symbol ini_chain(char *, int, Symbol);
  59. static Symbol symbtab_enter(char *, Symbol);
  60. static Symbol new_arith_op(char *, Symbol);
  61. static void ini_new_agg(Symbol);
  62.  
  63. void init_sem()                                                    /*;init_sem*/
  64. {
  65.     /*
  66.      * This is the primary initialization procedure.  It is called
  67.      * when the compiler is initialized.
  68.      *
  69.      */
  70.  
  71.     /*VARDECL*/
  72.     Tuple constr_new;
  73.     int        i;
  74.     Tuple tup;
  75.     Symbol sym;
  76.     char   *id;
  77.     Fordeclared fd;
  78.     static char *char_names[] = {
  79.         "NUL 0",
  80.         "SOH 1",
  81.         "STX 2",
  82.         "ETX 3",
  83.         "EOT 4",
  84.         "ENQ 5",
  85.         "ACK 6",
  86.         "BEL 7",
  87.         "BS 8",
  88.         "HT 9",
  89.         "LF 10",
  90.         "VT 11",
  91.         "FF 12",
  92.         "CR 13",
  93.         "SO 14",
  94.         "SI 15",
  95.         "DLE 16",
  96.         "DC1 17",
  97.         "DC2 18",
  98.         "DC3 19",
  99.         "DC4 20",
  100.         "NAK 21",
  101.         "SYN 22",
  102.         "ETB 23",
  103.         "CAN 24",
  104.         "EM 25",
  105.         "SUB 26",
  106.         "ESC 27",
  107.         "FS 28",
  108.         "GS 29",
  109.         "RS 30",
  110.         "US 31",
  111.         "EXCLAM 33",
  112.         "QUOTATION 34",
  113.         "SHARP 35",
  114.         "DOLLAR 36",
  115.         "PERCENT 37",
  116.         "AMPERSAND 38",
  117.         "COLON 58",
  118.         "SEMICOLON 59",
  119.         "QUERY 63",
  120.         "AT_SIGN 64",
  121.         "L_BRACKET 91",
  122.         "BACK_SLASH 92",
  123.         "R_BRACKET 93",
  124.         "CIRCUMFLEX 94",
  125.         "UNDERLINE 95",
  126.         "GRAVE 96",
  127.         "LC_A 97",
  128.         "LC_B 98",
  129.         "LC_C 99",
  130.         "LC_D 100",
  131.         "LC_E 101",
  132.         "LC_F 102",
  133.         "LC_G 103",
  134.         "LC_H 104",
  135.         "LC_I 105",
  136.         "LC_J 106",
  137.         "LC_K 107",
  138.         "LC_L 108",
  139.         "LC_M 109",
  140.         "LC_N 110",
  141.         "LC_O 111",
  142.         "LC_P 112",
  143.         "LC_Q 113",
  144.         "LC_R 114",
  145.         "LC_S 115",
  146.         "LC_T 116",
  147.         "LC_U 117",
  148.         "LC_V 118",
  149.         "LC_W 119",
  150.         "LC_X 120",
  151.         "LC_Y 121",
  152.         "LC_Z 122",
  153.         "L_BRACE 123",
  154.         "BAR 124",
  155.         "R_BRACE 125",
  156.         "TILDE 126",
  157.         "DEL 127",
  158.         " "
  159.     };
  160.  
  161.     if (cdebug2 > 3) TO_ERRFILE("AT PROC : INIT_SEM;");
  162.  
  163.     lib_stub = tup_new(0);
  164.  
  165.     seq_node = tup_new(400);
  166.     seq_node_n = 0;
  167.  
  168.     seq_symbol = tup_new(300);
  169.     seq_symbol_n = 0;
  170.  
  171. #ifdef TBSL
  172.     unit_nodes = tup_new(30);
  173.     unit_nodes_n = 0;
  174. #endif
  175.  
  176.     stub_info = tup_new(0);
  177.     unit_number_now = 0;
  178.  
  179.     NOT_CHOSEN = tup_new(0);
  180.  
  181.     init_nodes = tup_new(30);
  182.     init_symbols = tup_new(0);
  183.     /* op_designators no longer needed, just use op_desig_array */
  184.  
  185. #ifdef COMMENT
  186.     /* retained for documentation purposes (DS 26 jun 84) */
  187.     op
  188.         misc_attributes = {
  189.         'ADDRESS', 'IMAGE'},
  190.             u_integer_attributes = {
  191.             'AFT',         'COUNT',     'DIGITS',     'EMAX',
  192.                 'FIRST_BIT',     'FORE',     'LAST_BIT',     'LENGTH',
  193.                 'MACHINE_EMAX',     'MACHINE_EMIN', 'MACHINE_MANTISSA',
  194.             'MACHINE_RADIX', 'MANTISSA',     'POS',         'POSITION',
  195.                 'SAFE_EMAX',     'SIZE',     'STORAGE_SIZE', 'WIDTH'
  196.                 },
  197.             ??attributes := misc_attributes + u_integer_attributes +
  198.  
  199.                 overloaded_attributes = {
  200.                 'BASE',         'FIRST',     'LAST',      'PRED',
  201.                     'RANGE',     'SUCC',     'VAL',          'VALUE'
  202.                     },
  203.                     float_attributes = {
  204.                     'DELTA',     'EPSILON',   'LARGE',     'SMALL', 'SAFE_LARGE',
  205.                         'SAFE_SMALL'
  206.                         },
  207.  
  208.                         boolean_attributes = {
  209.                         'CONSTRAINED', 'MACHINE_OVERFLOWS', 'MACHINE_ROUNDS',
  210.                             'CALLABLE',    'TERMINATED'
  211.                             },
  212.  
  213. #endif
  214.  
  215.     /* Initialize global mappings for abstract syntax tree and symbol table.*/
  216.     /*
  217.      * N_KIND    := {[OPT_NODE, as_opt]};
  218.      * N_AST     := {[OPT_NODE, []]};
  219.      * N_VAL     := {};
  220.      * N_LIST    := {[OPT_NODE, []]};
  221.      */
  222.  
  223.     /* Initialize OPT_NODE - will get unit 0, seq 1, which is used in places */
  224.     /*  to identify it; then remove from seq_node so it isn't modified         */
  225.     OPT_NODE = node_new(as_opt);
  226.     N_LIST(OPT_NODE) = tup_new(0);
  227.  
  228.     scope_st = tup_new(0);
  229.     newtypes = tup_new(0);
  230.     has_return_stk = tup_new(0);
  231.     current_instances = tup_new(0);
  232.     lab_seen = tup_new(0);
  233.     /* current_node = tup_new(0); need not initialize for C */
  234.     /* need to decide representation for unit_name*/
  235.     unit_name = "";
  236. #ifdef IBM_PC
  237.     /* copy literals */
  238.     unit_name = strjoin("","");
  239. #endif
  240.  
  241.     /* need to use setname to enter identifier names for initial symbols
  242.      * need to see if handle C semantics w.r.t. string constants properly
  243.      * here also
  244.      */
  245.     /* need to copy literals on PC since code overlaid */
  246. #ifdef IBM_PC
  247. #define setname(sym, str) ORIG_NAME(sym) = strjoin(str, "");
  248. #else
  249. #define setname(sym, str) ORIG_NAME(sym) = str
  250. #endif
  251.  
  252.     OPT_NAME = sym_new(na_obj);
  253.     setname(OPT_NAME, "opt_name");
  254.  
  255. #define syminit1(sym, na, typ) sym = sym_new(na); TYPE_OF(sym) = typ
  256.     syminit1(symbol_integer, na_type, symbol_integer);
  257.     setname(symbol_integer, "INTEGER");
  258.     syminit1(symbol_short_integer_base, na_type, symbol_integer);
  259.     setname(symbol_short_integer_base, "SHORT_INTEGER\'base");
  260.     syminit1(symbol_short_integer, na_type, symbol_short_integer_base);
  261.     setname(symbol_short_integer, "SHORT_INTEGER");
  262.     syminit1(symbol_universal_integer, na_type, symbol_integer);
  263.     setname(symbol_universal_integer, "universal_integer");
  264.     syminit1(symbol_float, na_type, symbol_float);
  265.     setname(symbol_float, "FLOAT");
  266.     syminit1(symbol_universal_real, na_type, symbol_float);
  267.     setname(symbol_universal_real, "universal_real");
  268.     syminit1(symbol_dfixed, na_type, symbol_dfixed);
  269.     setname(symbol_dfixed, "$FIXED");
  270.     syminit1(symbol_natural, na_subtype, symbol_integer);
  271.     setname(symbol_natural, "NATURAL");
  272.     syminit1(symbol_positive, na_subtype, symbol_integer);
  273.     setname(symbol_positive, "POSITIVE");
  274.     syminit1(symbol_duration, na_type, symbol_duration);
  275.     setname(symbol_duration, "DURATION");
  276.     syminit1(symbol_character, na_enum, symbol_character);
  277.     setname(symbol_character, "CHARACTER");
  278.     syminit1(symbol_boolean, na_enum, symbol_boolean);
  279.     setname(symbol_boolean, "BOOLEAN");
  280.     syminit1(symbol_string, na_array, symbol_string);
  281.     setname(symbol_string, "STRING"); /* ?? */
  282.     tup = tup_new(2);
  283.     tup[1] =(char *) tup_new1((char *) symbol_positive);
  284.     tup[2] =(char *) symbol_character;
  285.     SIGNATURE(symbol_string) = tup;
  286.     symbol_character_type = sym_new(na_enum);
  287.     setname(symbol_character_type, "char_type");
  288.     root_type(symbol_character_type) = symbol_character_type;
  289.     syminit1(symbol_string_type, na_array, symbol_string_type);
  290.     setname(symbol_string_type, "string_type");
  291.     tup = tup_new(2);
  292.     tup[1] = (char *) tup_new1((char *) symbol_positive);
  293.     tup[2] = (char *) symbol_character_type;
  294.     SIGNATURE(symbol_string_type) = tup;
  295.     syminit1(symbol_daccess, na_access, symbol_daccess);
  296.     setname(symbol_daccess, "$ACCESS");
  297.     syminit1(symbol_null, na_null, symbol_any);
  298.     setname(symbol_null, "null");
  299.     syminit1(symbol_main_task_type, na_task_type, symbol_main_task_type);
  300.     setname(symbol_main_task_type, "main_task_type");
  301.     syminit1(symbol_constrained, na_discriminant, symbol_boolean);
  302.     setname(symbol_constrained, "constrained");
  303.     syminit1(symbol_none, na_type, symbol_none);
  304.     setname(symbol_none, "none");
  305.     symbol_standard0 = sym_new(na_package);
  306.     setname(symbol_standard0, "STANDARD#0");
  307.  
  308.     /* new symbol definitions that are common with the code genera